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APPENDIX  3 
FRAME  C 


100  REM         THIS  PROGRAM  READS  STANDARD  SPECTRA  FROM  QUADRANT  2 

120  G0SU3  1000 

130  PRINT  "ENTER  NO.   OF  ELEMENTS" 

135  INPUT  N 

140  PRINT 

141  CALL  4,(1) 

142  CALL  4, (3) 

143  IF     FNA(2)=  0  GOTO  146 

144  LET  E0=  FNA(2)/1000 

145  GOTO  151 

146  PRINT  "ENTER  EO    (YOUR  TOA  IS" ; M3 ; "DEG) " 

147  INPUT  EO 

148  LET  E1=(E0+.00001)*1000 

149  LET  Ll=  FNC(2) 

150  CALL  3, LI, El 

151  LET  Ll=  FNC(3) 

152  CALL  3, LI,  0 

154  CALL  4, (3) 

155  CALL  4, (1) 
160  LET  Z  [N]=4 
170  LET  Z[N+1]=14 

180  LET  Z[N+2]=79 

181  PRINT 

185  PRINT  "ENTER  CON,   ATNO,   LINE  CODE  AND  VALENCE  FOR  EACH" 

190  FOR  1=  0  TO  N+2 

200         IF  I>N-1  GOTO  230 

210         INPUT  C [I]  ,Z  [I]  ,L[Il  ,Q[I] 

220  PRINT 

230         LET  L9=l 

240         G0SU3  1500 

250         IF  L[I1=  0  GOTO  280 

260         LET  L9=2 

270         GOSUB  1500 

274  IF     FNG(I)>=1  GOTO  280 

275  PRINT  "LINE  OF  ";Z[I];"   BELOW  1  KV" 

276  GOTO  380 
280  NEXT  I 

285  GOSUB  8000 

290  LET  N3=  0 

291  CALL  4,(1) 

292  CALL  4,(3) 

293  LET  Ll=  FNC(5) 

294  CALL  3,L1,K1*10000 

295  CALL  4,(3) 

296  CALL  4,(1) 
300  GOSUB  3000 
310  GOSUB  2200 
312  CALL  4,(1) 
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316  CALL  4 , (3) 

320  GOSUB  5100 

330  FOR  1=  0  TO  N-1 
335         LET  M[I]=W[I] 

340  NEXT  I 

352  CALL  4, (3) 

355  CALL  4,  (1) 

360  GOSUB  5500 

370  GOSUB  2700 

380  STOP 

390  END 

500  REM       THIS  PROGRAM  READS  A  SPECIMEN  SPECTRUM  FROM  QUADRANT  1 

501  REM  THE  STANDARDS   INFORMATION  FROM  QUADRANT  4  AND  PRINTS 

502  REM         QUANTITATIVE  RESULTS.    Al ,   Bl  AND  DISPLAY  ON. 
520  GOSUB  1000 

530  CALL  4,(0) 

550  CALL  4,(3) 

570  LET  N9=  FNA(l) 

57  5  LET  N4=  FNA(3) 

576  LET  Ll=  FNC(3) 

577  CALL  3,L1,1 

579  IF  N4=l  GOTO  595 

530  PRINT  "ENTER  NO.   OF  ELEMENTS" 

590  INPUT  N 

591  LET  Ll=  FNC(4) 

592  CALL  3,L1,N 

595  LET  E0=  FNA(2)/1000 

596  LET  N=  FNA(4) 
600  PRINT 

610  LET  Z [N]=4 

620  LET  Z[N+1]=14 

630  LET  Z [N+2]=79 

635  IF  N4=l  GOTO  650 

640  PRINT  "ENTER  AT.   NO.   FOR  EACH  ELEMENT" 

650  FOR  1=  0  TO  N+2 
660         IF  I>=N  GOTO  680 
665         IF  N4=l  GOTO  675 

670  INPUT  Z (I] 

671  LET  Ll=  FNC (900+1) 

672  CALL  3,L1,Z(I] 

673  GOTO  680 

675         LET  Z[I]=  FNA(900+I) 

680         LET  L9=l 

690         GOSUB  1500 

700         IF  I>=N  GOTO  800 

710         FOR  J=10  TO  N9  STEP  10 

720  IF     FNA(J)=Z(I]   GOTO  750 

730         NEXT  J 

740         GOTO  800 

750         LET  L[I]=  FNA(J+1) 
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760         LET  Q[I1=  FNA(J+2) 

770         LET  L9=2 

780         GOSUB  1500 

790         GOTO  810 

800         LET  L[I]=  0 

810     NEXT  I 

815  PRINT 

820     CALL  4,(3) 

840     CALL  4, (  0) 

855     GOSUB  8000 

860     LET  N3=3 

865     IF  N4=l  GOTO  880 

870     GOSUB  3000 

880     GOSUB  5500 

890  STOP 

900  END 

1000  REM  THIS  SUBROUTINE  READS   IN  COEFFICIENTS  FOR  COMPUTING 

1001  REM         ENERGIES,   ABSORPTION  EDGE  RATIOS,   ATOMIC  WEIGHTS, 

1002  REM         KB/K  RATIOS,   AND  ELECTRON  INCIDENCE  AND  X-RAY 

1003  REM         EMISSION  ANGLES 

1005  DIM  C[12]  ,Z  [12]  ,L[12]  ,Q[12]  ,E[8,12]  ,G[16,12] 

1006  DIM  M[12]  ,W[12]  ,X[3]  ,Y[3]  ,U[12]  ,F[3,12]  ,S[16,12] 

1007  DIM  0[12,12] ,H[24,12] ,V[12,12] ,P[12,12] 
1010     DIM  K[8,2]  ,T[16,2]  ,R[9]  ,A[92]  ,B[50] 

1020  DEF  FNA(I)=  DTA  ((I-  LCN  (118))/  LCN  (120)) 
1025  DEF  FNE(I)=  ECL  ((I-  LCS  (134))/  LCS  (136)) 
1030     DEF     FNC(I)=(I-  LCN    (118))/  LCN  (120) 

1035  DEF     FNN (I)=1000* (I-  FNE (   0))/(   FNE(IOOO)-  FNE (  0)) 

1036  DEF     FNL(I)=2.905*  SQR  (I)-3o063 

1037  DEF     FNJ(I)=9. 76*1+58. 5*1" (-.19) 

1038  DEF     FNF(I)=. 2567*1-6. 8176 

1039  DEF     FNM(I)=  EXP   (34.165*1-30.027*  SQR   ( I ) +8 . 5268 ) /I . 6 

1040  FOR  1=  0  TO  9 
1050         READ  R[I] 
1060     NEXT  I 

1070     DATA     1,   1,   1.17,   1.63,   1,   1.16,   1.4,   1.621,   1.783,  1 

1080     FOR  J=  0  TO  2 

1090         FOR  1=  0  TO  8 

1100  READ  K[I,J] 

1110         NEXT  I 

1120     NEXT  J 

1130     DATA  -3. 97931E-2,-. 033916, -8. 65397E-2,-. 228343,  1.25179 

1140     DATA     .834903,    .442217,    .25141,  .272951 

1150     DATA     2.423,   2.82526,   3.32315,  4.31172,-7.838 

1160     DATA  -4. 14925, -.979241,    .931913,  .688906 

1170     DATA     5.5091,   9.03526,   10.2505,  12.0025,-11.5803 

1180     DATA  -3.33802,   3.15348,   8.03561,  7.4243 

1190     FOR  J=  0  TO  2 

1200         FOR  1=  0  TO  16 

1210  READ  T [I ,J] 
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1220 
1230 
1240 
1242 
1244 
1246 
1250 
1252 
1254 
1256 
1260 
1262 
1264 
1266 
1270 
1280 
1290 
1300 
1310 
1311 
1320 
1330 
1340 
1350 
1351 
1360 
1361 
1370 
1371 
1380 
1381 
1390 
1391 
1400 
1401 
1410 
1411 
1420 
1421 
1430 
1431 
1432 
1440 
1450 
1454 
1455 
1460 
1470 
1480 
1485 


NEXT  I 
NEXT  J 

DATA  -1 .997 26E-2,-. 12 3941 ,-.47 555, -.060 101 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


READ  B[I] 
NEXT  I 

DATA     .011,    .027,  .04, 
DATA     .108,    .114,  .115, 
DATA     .121,    .121,  .123, 

FOR  1=1  TO  92 
READ  A [I] 


.117102, 

-.192466, 

-.  197431  , 

-3.22523E 

-3 

,  .035676 

2.88553E 

-3,   9.57107E-2,    .092961,  5. 

05888E-2 

.390705  , 

-.386042, 

-.603132, 

.322877 

2.22412, 

3.29533, 

6.84662, 

2.52781 

3.22414, 

3.83158, 

4.01718, 

2.48613, 

2 

.29113 

2.49221  , 

1  .69157  , 

1.7559, 

2.0035 

6.17432, 

6.14822, 

7.75598, 

.102358 

5.17774  , 

9.75836  , 

20.0833, 

5.6437 

9.58711  , 

10.9293, 

11.3323, 

8.37742, 

8 

.09392 

8.60965, 

6.76302, 

6.81839  , 

7.30182 

19.0119, 

18.7034  , 

21  .4878  , 

5.58269 

11  TO  30 

055,  .066, 
.117,  .119, 
.1235,  .125 


.078, 
.119  , 


085,  .097 
.121 


NEXT 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


1.003,  4.003,  6 
14.007,   16,  19, 


013,   10.82,  12.011 


94,  9 
20.18 

22.99,  24.31,  26.98,   28.09,   30.97,  32.06 

35.45,   39.95,   39.1,  40.08 

44.96,   47.9,   50.94,   52,   54.94,  55.85 

58.93,   58.71,  63.54,  65.37 

69.72,  72.59,  74.92,  78.96,  79.91 

83.8,   85.47,  87.62,  88.91,  91.22 

92.91,  95.94,  99,  101.1 

102.9,   106.4,   107.9,   112.4,   114.8,  118.7 
121.8,  127.6,   126.9,   131.3,   132.9,   137.3,  138.9 
140.1,   140.9,  144.2 

158.9,  162.5 


145,   150.4,   152,  157 
164.9,  167.3,   168.9,  173 
175,   178.5,   180.95,   183.85,  186.2 
190.2,  192.2,   195.1,  196.97 
200.6,   204.4,   207.2,   209,   210,  210 
222,   223,   226,   227,  232 
231,  238 
LET  M3=40 
LET  Q2=90 
LET  P6=9.165E-4 
LET  P7=8.579E-6 
LET  Ql=l/  SIN  (M3/57.2958) 
LET  Q2=  SIN  (Q2/57.2958) 
LET  Q3=149 
LET  Q3=Q3"2-14737.5 
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1490 
1492 
1495 
1500 
1501 
1520 
1530 
1540 
1550 
1560 
1570 
1580 
1590 
1600 
1610 
1700 
1701 
1710 
1720 
1730 
1740 
1750 
1760 
1770 
1780 
1790 
1800 
1810 
1820 
1830 
1840 
1850 
1860 
1870 
1880 
1890 
1900 
1910 
1920 
1930 
1940 
1945 
1950 
1955 
1960 
1970 
1980 
2000 
2010 
2020 


DEF     FNS(I)=  SQR    ( 2 5 0 0 *I +Q3 ) *4 . 24 6 6E-4 

DEF     FNG(I)=G[L[I]-1  ,1] 
RETURN 

REM         THIS   SUBROUTINE  COMPUTES  ALL  OF  THE  NECESSARY 
REM         EDGE  AND  LINE  ENERGIES 
LET  Zl=  LOG    (Z [I]  ) 
IF  L9=2  GOTO  1580 
FOR  Ml=  0  TO  8 

LET  E [Ml ,I]=  EXP 
NEXT  Ml 

IF  L9=l  GOTO  1610 
FOR  Ml=  0  TO  16 

LET  G[M1,I]=  EXP 
NEXT  Ml 
RETURN 

REM         THIS  SUBROUTINE  COMPUTES  ALL  MASS  ABSORPTION 
REM         COEFFICIENTS  REQUIRED 
DIM  D [3 , 3] 

0,   0]=-. 232229 
0,1]=-. 254471 


{K  [Ml,    0]*Z1*Z1+K  [Ml,l] *Z1-K [Ml,2] ) 


(T  [Ml ,    0] *Z1*Z1+T [Ml ,1] *Z1-T [Ml ,2] ) 


LET 
LET 
LET 
LET 
LET 
LET 
LET 
LET  D 
LET  D 
LET  D 
LET  D 
LET  D 
LET  D 
LET  D 


0,2]=. 256216 
0 ,3]=1 .35917 

1,  0]=4. 07005 
1,1]=4. 76925 

1 ,2] =1 .15119 
l,3]=-9 .49212 

2,  0]=-6. 22075 
2,1]=-10  .  3788 
2,2]=-5.68485 
2,3]=18.6408 
3,2]=2.6 
3,3]=2.22 


LET   Zl=  LOG    (Z  [I] ) 
LET  D[3,    0]=  EXP  (-4 
LET  D[3,l]=2.73 
IF   Z [I] <42  GOTO 
LET  D[3,l]=  EXP 
FOR  Ml=  0  TO  9 

LET  M3=M1+1 

IF  Ml=9  GOTO 

IF  E1<E[M1,I] 


552 2E-3*Z1*Z 1-6 .8535E-3*Z1+1 .07018) 


1910 

(-.11316*Z1*Z1+.836883*Z1-. 545969) 


1945 

GOTO  1970 

LET  L1=M1-  INT    (M3/3)-  INT    (M3/4)-   INT  (M3/7) 

LET  C2=  EXP    (D[   0 , Ll ] * Z 1  * Z 1+D [ 1 , Ll ] * Z 1+D [ 2 , Ll ]  ) /R [ Ml ] 

LET  A1=C2*(12.398/E1)^D[3,L1] 

GOTO  1980 


NEXT  Ml 

RETURN 

REM 

LET  I=N 
G0SU3  1700 


THIS   SUBROUTINE  COMPUTES  THE  DETECTOR  EFFICIENCY 
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2030  LET  A3=A1*1 .82*P6 

2040  LET  I=N+2 

2050  GOSUB  1700 

2060  LET  A4=Al*19.3*8E-7 

2070  LET  I=N+1 

2080  GOSUB  1700 

2090  LET  D2=  EXP   (-A3-A4-Al*2 . 33*P7 ) * (1-  EXP   (-Al*2 . 33* .469) ) 

2095  RETURN 

2100  REM         THIS  SUBROUTINE  COMPUTES  THE  ABSORPTION  FACTOR 

2101  REM         FOR  ANY  LINE 
2110  LET  X3=A2*Q1 

2120  LET  Gl= (EO^l .65-El^l .65) *Q2 

2130  LET  F1  =  1/(1+1.2E-6*G1*X3) '^2 

2140  RETURN 

2200  REM         THIS  SUBROUTINE  COMPUTES  BACKGROUND  UNDER  EACH  PEAK 

2220  FOR  1=  0  TO  1 

2230         LET  M[I]=  ROI    (I)/(   LCN    (158)-  LCN  (157)) 

2240         LET  W[I]=  FNE ( (  LCN   (157)+  LCN  (158))/2) 

2250  NEXT  I 

2260  FOR  J=  0  TO  1 

2270         LET  A2=  0 

2280         LET  E1=W[J] 

2290         FOR  1=  0  TO  N-1 

2300  GOSUB  1700 

2310  LET  A2=A2+C [I] *A1 

2320         NEXT  I 

2330        GOSUB  2000 

2340         GOSUB  2100 

2350         LET  T1=D2*F1/E1 

2360         LET  X[J]=E0-E1 

2370         LET  Y[J]=M[J]/T1 

2380         LET  U[J1=X[J]*X[J] 

2390  NEXT  J 

2400  LET  D1=X[  0]*U[1]-U[  0]*X[1] 

2410  LET  K1=(Y[1]*X[  0 ] -Y [  0]*X[1])/Dl 

2420  LET  K2=(Y[  0 ] *U [ 1 ] -Y [ 1 ] *U [  0])/Dl 

2425  IF  L[  0]=10  GOTO  2620 

2430  FOR  J=  0  TO  N-1 

2440         IF  L[J]=  0  GOTO  2610 

2450         LET  J1=L[J]-1 

2460         LET  E1=G[J1,J] 

2470         LET  T5=  ROI  (J+2) 

2480         LET  A2=  0 

2490         FOR  1=  0  TO  N-1 

2500  GOSUB  1700 

2510  LET  A2=A2+C [I] *A1 

2520         NEXT  I 

2530         GOSUB  2000 

2540         GOSUB  2100 

2550         LET  T1=D2*F1/E1 
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2560         LET  X1=E0-E1 

2570         LET  G1=T1* (K1*X1*X1+K2*X1) 

2580         LET  G2=  LCN    (153)-  LCN  (157) 

2590         LET  M [J] =T5-G1*G2 

2600         LET  F [1 , J] =F1 

2610  NEXT  J 

2620  RETURN 

2700  REM         THIS   SUBROUTINE  WRITES   STANDARDS   INFORMATION  INTO 

27  01  REM  QUADRANT  4. 

2710  CALL  4,(1) 

2730  CALL  4,(3) 

2750  LET  N9=  FNA(l) 

2760  FOR  1=  0   TO  N-1 

2770         IF  L[I]=  0  GOTO  2850 

2780         LET  N9=N9+10 

2790         LET  Ll=  FNC(N9) 

2800         CALL  3 ,L1 ,Z  [I] 

2810         LET  Ll=  FNC(N9+1) 

2820         CALL  3,Ll,L[I] 

2830         LET  Ll=  FNC (N9+2) 

2840         CALL  3,Ll,M[I] 

2842  LET  Ll=  FNC (N9+3 ) 

2843  CALL  3,L1,Q[I] 
2850  NEXT  I 

2860  LET  Ll=  FNC  (1) 

2870  CALL  3,Ll,N9 

2880  CALL  4,(3) 

2900  CALL  4,(1) 

2920  RETURN 

3000  REM         THIS   SUBROUTINE  COMPUTES  OVERLAP  FUNCTION  OF  ONE 

3001  REM  PEAK  ON  ANOTHER. 
3010  LET  G4=  0 

3015  IF  N3>  0  GOTO  3025 

3017  CALL  4,(1) 

3020  GOTO  3027 

3025  CALL  4  ,  (   0  ) 

3027  CALL  4,(3) 

3029  FOR  1=300  TO  899 

3030  LET  Ll=  FNC(I) 

3031  CALL   3,L1,  0 

3032  NEXT  I 

3034  FOR  1=  0  TO  N-1 

3035  IF  L[I]=  0  GOTO  3200 
3040         LET  E7=  FNG(I) 

3050         LET  S6=  FNS (E7) 

3052         LET  T5=  ROI  (1+2) 

3056         LET  E3=  FNE  (   LCN  (157)) 

3060         LET  E4=  FNE  (  LCN  (158)) 

3070         LET  X2=  (E3-E7)/S6/l .4142 

3080         G0SU3  4500 
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3085  G0SU3  4200 

3090  LET  El=  ABS  (E8)/2 

3100  LET  X2= (E4-E7)/S6/l .4142 

3110  GOSUB  4500 

3120  LET  E2=  ABS  (E8)/2 

3130  IF  E3<=E7  GOTO  3160 

3140  LET  W[I]=E2-E1 

3150  GOTO  3195 

3160  IF  E4>=E7  GOTO  3190 

3170  LET  W[I]=E1-E2+G4 

3180  GOTO  3195 

3190  LET  W[I]=E1+E2+G4 

3195  LET  M[I]=W[I] 

3200  NEXT  I 

3205  FOR  Kl=  0  TO  1 

3230  FOR  11=  0  TO  N-1 

3240  IF  L[I1]=  0  GOTO  3390 

3245  LET  Jl=  0 

3250  LET  T5=  FNG(Il) 

3260  LET  D3=4*  FNS(T5) 

3270  LET  I=N+1 

3280  LET  S6=  ROI  (11+2) 

3290  LET  E3=  FNE  (  LCN  (157)) 

3300  LET  E4=  FNE (  LCN  (158)) 

3310  FOR  J=  0  TO  N-1 

3320  IF  L[J]=  0  GOTO  3350 

3325  IF  Kl=l  GOTO  3340 

3330  IF  J=I1  GOTO  3340 

3335  GOTO  3350 

3340  LET  X2=l/  LOG    (EO*EO/E [3 , J] /E [8 , J] ) 

3345  GOSUB  3500 

3350  NEXT  J 

3360  IF  Kl=l  GOTO  3390 

3381  FOR  J=  0  TO  16 

3382  LET  Ll=  FNC ( I 1 *20+700+J ) 

3384  LET  02=S [J , II ] *100000 

3385  IF  02>  0  GOTO  3387 

3386  LET  02=  0 

3387  CALL  3,Ll,02 

3389  NEXT  J 

3390  NEXT  II 


3395  NEXT  Kl 

3400  CALL  4,(3) 

3410  IF  N3=  0  GOTO  3440 

3420  CALL  4, (  0) 

3430  GOTO  3450 

3440  CALL  4,(1) 

3450  RETURN 

3490  REM  COMPUTE  OVERLAPS  FOR  EACH  LINE 

3500  LET  02=  0 
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3501  LET  X[l]=  EXP    (2.373*  LOG    (  Z  [  J ] ) - 3  .  9 0 2 ) 

3502  LET  X[2]=  EXP    (2.945*  LOG    (  Z  [  J ] ) -1 3  .  94 ) 

3503  LET  X[3]=2.27E-5*Z  [J] ^2-.001359*Z  [J1-.00657 

3504  FOR  L2=  0  TO  8 

3505  LET  M1=L2+1 

3506  LET  I2=M1-   INT    (Ml/3)-   INT    (Ml/4)-   INT  (Ml/7) 

3507  LET  M3=2*(   INT    (Ml/12)-   INT    (Ml/6)+   INT  (Ml/7)) 

3508  IF  E[L2,J]>=E0  GOTO  3513 

3509  LET  E1=E0/E [L2 , J] 

3510  LET  E2=1166*E [L2 , J] /  FNJ(Z[J]) 

3511  LET  X1=E1*E2 

3512  LET  U [Ml] =M3*  (El-1-  LOG    (E2)/E2*(   FNL(Xl)-  FNL  (  E 2 ) )  ) *X  [  I  2 ] 

3513  NEXT  L2 

3514  LET  A4=l 

3515  LET  A5=l 

3516  LET  Al=l 

3517  LET  A2=l 

3518  LET  A3=l 

3519  IF  L[J]=3  GOTO  3530 

3520  IF  L[J]=2  GOTO  3525 

3521  LET  A2=U [4] /U [1] *  FNF(Z[J]) 

3522  LET  A4=U [ 2 ] /U [ 1 ] *  FNF(Z[J]) 

3523  LET  A5=U [3] /U [1] *  FNF(Z[J]) 

3524  GOTO  3533 

3525  LET  Al=U [ 1 ] /U [ 4 ] /  FNF(Z[J]) 

3526  LET  A3=  FNM(X2) 

3527  LET  A4=U  [  2 ] /U  [4] 

3528  LET  A5=U [3] /U  [4] 

3529  GOTO  3533 

3530  LET  A2=l/  FNM(X2) 

3531  LET  A4=U [2] /U [4] /  FNM(X2) 

3532  LET  A5=U [ 3 ] /U [ 4 ] /  FNM(X2) 

3533  LET  S[  0,J]=A1 

3534  IF   Z[J]>50  GOTO  3540 

3535  LET  Rl=B [Z [J] ] 

3536  IF  Z[J]<=30  GOTO  3533 

3537  LET  Rl=.115*(   LOG  (Z[J])-2.3) 

3538  LET  S [ 3 , J ] =R1/ ( 1-Rl ) * Al 
3540  LET  S[1,J]=A2 

3550  LET  S[2,J]=A3 

3571  LET  S[4,J]=.1*A2 

3572  LET  S [5 , J] = . 044*A2 

3573  LET  S [6 , J] = ( . 2808- . 0016*Z [J] ) *A2 

3574  LET  S [7 ,J]=A5 

3575  LET  S [8 ,J]=.154*A5 

3576  LET  S [9 , J] = . 02*A5 

3577  LET  S [10 , J] = . 166*A4 

3578  LET  S [11 , J] = . 068*A4 

3579  LET  S [ 12 , J] = . 104 *A4 
3602  LET  S[13,J]=.06*A3 
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3603  LET  S[14,J]=.5*A3*U[8]/U[9) 

3604  LET  S[15,J]=.05*A3*U[7]/U[9] 

3605  LET  S [16 ,J]=.01*A3*U [6] /U [9] 
3625  IF  I1=J  GOTO  3730 

3630  LET  E7=  FNG(J) 

3640  LET  S6=  FNS(E7) 

3642  FOR  12=  0  TO  16 

3643  IF  S[I2,J]>  0  GOTO  3645 

3644  LET  S[I2,J]=  0 

3645  NEXT  12 

3730  FOR  12=  0  TO  16 

3740  LET  E7=G[I2,J1 

3742  IF  T5=E7  GOTO  3840 

3744  IF  E7<1  GOTO  3840 

3746  IF  E7>E0  GOTO  3840 

3750  LET  S6=  FNS(E7) 

3760  IF  E7<T5-D3  GOTO  3840 

3770  IF  E7>T5+D3  GOTO  3820 

3780  G0SU3  4000 

3805  IF  Kl=  0  GOTO  3815 

3310  LET  02=01/W[J1 *S [12, J] 

3812  GOSUB  3855 

3814  GOTO  3840 

3815  IF  I2=L[J]-1  GOTO  3840 

3816  LET  W[J]=W[J1+01*S [I2,J1 

3819  GOTO  3840 

3820  LET  S8=  0 
3825  GOSUB  3900 

3830  LET  02=01/W[J] *S8*S [I2,J] 

3835  GOSUB  3855 

3840  NEXT  12 

3850  RETURN 

3355  LET  02=  INT  (02*100000) 

3860  IF  02=  0  GOTO  3886 

3861  LET  E9=  0 

3862  LET  X2=J 
3864  GOTO  3876 
3366  LET  E9=l 
3868  LET  X2=I2 
3870  GOTO  3876 
3872  LET  E9=2 
3874  LET  X2=02 

3376  LET  Ll=  FNC (Il*40+300+E9+Jl) 

3373  CALL  3,L1,X2 

3330  IF  E9=  0  GOTO  3866 

3882  IF  E9=l  GOTO  3872 

3884  LET  Jl=Jl+3 

3886  RETURN 

3890  REM           COMPUTE  ESCAPE  PEAKS 

3900  IF  E7<1.833  GOTO  3990 
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3903  LET  E1=E7 

3905  LET  E7=E7-1.74 

3910  IF  T5<E7-D3  GOTO  3990 

3920  IF  T5>E7+D3  GOTO  3990 

3940  GOSUB  1700 

3950  LET  S7=.5* (1-327 .9/Al*  LOG   ( l+Al/327 . 9 ) ) 

3960  LET  S8=.038*S7/(1-.038*S7) 

3970  LET  S6=  FNS(E7) 

3930  GOSUB  4000 

3990  RETURN 

4000  REM  THIS  FUNCTION  COMPUTES  SPECIFIC  OVERLAPS 

4010  LET  X2=(E3-E7)/S6/1.4142 

4020  GOSUB  4500 

4025  GOSUB  4200 

4030  LET  E2=  ABS  (E8)/2 

4040  LET  X2= (E4-E7)/S6/l. 4142 

4050  GOSUB  4500 

4055  LET  E8=  ABS  (E8)/2 

4060  IF  E3>=E7  GOTO  4100 

4070  IF  E4<=E7  GOTO  4120 

4080  LET  01=E2+E8+G4 

4090  RETURN 

4100  LET  Ol=E8-E2 

4110  RETURN 

4120  LET  01=E2-E8+G4 

4130  RETURN 

4200  REM  THIS  FUNCTION  COMPUTES  AN  INCOMPLETE  CHARGE 

4201  REM  CORRECTION  FOR  ALL  PEAKS. 
4210  LET  G4=  0 

4220  LET  Xl=6 

4230  LET  X3=.l 

4240  IF  E7>=6.4  GOTO  4300 

4250  LET  X1=.86166*E7*E7-7.4431*E7+18.342 

4260  LET  X3=-.01683*E7*E7+.14129*E7-. 11489 

4270  IF  X3<=  0  GOTO  4400 

4300  IF  E3>=E7  GOTO  4400 

4310  LET  X2= {E3-E7)/X3 

4320  LET  G4=X1*X3*X3* (1-  EXP  (X2)*(l-X2)) 

4330  IF  E4>=E7  GOTO  4400 

4340  LET  X2= (E4-E7)/X3 

4350  LET  G4=G4-X1*X3*X3*(1-  EXP  (X2)*(l-X2)) 

44  00  RETURN 

4500  REM         THIS  FUNCTION  INTEGRATES  AREA  UNDER  A  GAUSSIAN  PEAK 

4510  LET  Tl  =  2''(-27) 

4520  IF  X2=  0  GOTO  5070 

4530  LET  Yl=  ABS  {X2) 

4540  LET  Y2=Y1*Y1 

4550  IF  Y1<=1  GOTO  4630 

4560  LET  Cl=2"(3.5) 

4570  LET  U1=.83*C1 
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4580  LET  Sl=2" {Cl*Cl-8) 

4590  IF  Y1<=U1  GOTO  4770 

4600  LET  E8=l 

4610  LET  E9=  0 

4620  GOTO  4730 

4630  LET  S2=  0 

4640  LET  Dl=l 

4650  LET  T2=l 

4660  LET  P2=2*Y2 

4670  LET  Dl=Dl+2 

4680  LET  T2=P2*T2/D1 

4690  LET  S2=T2+S2 

4700  IF  T2>=T1  GOTO  4670 

4710  LET  E8=  (S2+1) *1  .12838*Y1*  EXP  (-Y2) 

4720  LET  E9=l-E8 

4730  IF  X2>=  0  GOTO  4760 

4740  LET  E8=-E8 

4750  LET  E9=2-E9 

4760  RETURN 

4770  LET  F2=  0 

4780  LET  G2=l 

4790  LET  F1=2*Y1 

4800  LET  G1=2*Y2+1 

4810  LET  P3=F1/G1 

4820  LET  Wl=l 

4830  LET  Bl=Gl+4 

4840  LET  A5=-W1*(W1+1) 

4850  LET  F3=B1*F1+A5*F2 

4860  LET  G3=B1*G1+A5*G2 

4870  LET  F4=F3/G3 

4880  IF     ABS   (1-F4/P3 ) <=T1  GOTO  5040 

4890  IF  P3>F4  GOTO  5030 

4900  IF  G3<S1  GOTO  4950 

4910  LET  F3=F3/S1 

4920  LET  G3=G3/S1 

4930  LET  F1=F1/S1 

4940  LET  G1=G1/S1 

4950  LET  F2=F1 

4960  LET  G2=G1 

4970  LET  F1=F3 

4980  LET  G1=G3 

4990  LET  Wl=Wl+2 

5000  LET  Bl=Bl+4 

5010  LET  P3=F4 

5020  GOTO  4840 

5030  LET  F4=P3 

5040  LET  E9=F4*  EXP   (-Y2) *1 . 12838/2 

5050  LET  E8=l-E9 

5060  GOTO  4730 

5070  LET  E8=  0 
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5030  LET  E9=l 

5090  RETURN 

5100  REM  THIS  SUBROUTINE  CORRECTS   PEAKS  FOR  OVERLAP  USING 

5101  REM  PREVIOUSLY  COMPUTED  OVERLAP  FACTORS. 
5110  FOR  J=  0  TO  N-1 

5120  IF  L[J]=  0  GOTO  5230 

5140  LET  A2=  0 

5146  LET  El=  FNG(J) 

5147  GOSUB  2000 

5148  FOR  1=  0  TO  N-1 
5150  GOSUB  1700 

5152  LET  A2=A2+C [I] *A1 

5154  NEXT  I 

5156  GOSUB  2100 

5158  LET  F[3,J]=F1*D2 

5220  LET  W[J]=M[J] 

5230  NEXT  J 

5240  FOR  Tl=  0  TO  2 

5250  FOR  31=  0  TO  N-1 

5255  IF  L[B1]=  0  GOTO  5370 

5260  LET  Rl=  0 

5265  LET  J=Bl*40+300 

5270  FOR  Dl=  0  TO  26  STEP  3 

5275  LET  L2=  FNA(J+D1) 

5285  LET  Gl=  FNA(J+D1+1) 

5290  LET  Yl=  FNA ( J+Dl+2 ) /lO 00 00 

5292  IF  Yl=  0  GOTO  5360 

5295  LET  E1=G[G1,L2] 

5300  LET  A2=  0 

5305  GOSUB  2000 

5310  FOR  1=  0  TO  N-1 

5315  GOSUB  1700 

5320  LET  A2=A2+C [I] *A1 

5325  NEXT  I 

5330  GOSUB  2100 

5340  LET  R1=R1+F1*D2*W[L2]*Y1/F[3,L2] 

5350  NEXT  Dl 

5360  LET  W[B1] =M [Bl]-Rl 

5370  NEXT  Bl 

5380  NEXT  Tl 

5390  RETURN 

5500  REM         THIS  SUBROUTINE  COMPUTES  THE  MATRIX  CORRECTIONS  FOR 

5501  FOR  J=  0  TO  12 

5502  FOR  1=  0  TO  12 

5503  LET  P[I,J]=  0 

5504  NEXT  I 

5505  NEXT  J 

5510  FOR  J=  0  TO  N-1 

5520  IF  L[J]=  0  GOTO  6400 

5530  LET  B1=L[J] ^2-1 
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5540  IF  BK9  GOTO  5560 

5550  LET  Bl=  0 

5560  LET  U(J]=E0/E[B1,J1 

5570  IF  U[J]>=1.5  GOTO  5590 

5580  PRINT  "OVERVOLTAGE  TOO  LOW" 

5590  LET  El=  FNG(J) 

5600  FOR  1=  0  TO  N-1 

5610  GOSUB  1700 

5620  LET  H[I ,Jl=Al 

5630  NEXT  I 

5750  LET  A2=H [J, J] 

5760  GOSUB  2100 

5770  LET  F[  0,J]=Fl 

5780  IF  L[J]>1  GOTO  5820 

5790  LET  Cl=5 

5800  LET  F3=  0 

5810  GOTO  5890 

5820  IF  L[J]>2  GOTO  5860 

5830  LET  Cl=3.5 

5840  LET  F3=l 

5850  GOTO  5890 

5860  IF  L[J]>3  GOTO  5790 

5870  LET  Cl=3.5 

5880  LET  F3=2 

5890  FOR  11=  0  TO  N-1 

5900  IF  I1=J  GOTO  6160 

5910  LET  P3=  0 

5920  LET  L2=(P3+1) "2-1 

5930  IF  1.02*E [L2,I1]-E0>=  0  GOTO  6130 

5940  IF  G[P3,I1] <E [B1,J]   GOTO  6160 

5950  IF  G[P3,I1]>E[B1,J]+C1  GOTO  6130 

5960  LET  P[J,I1]=P3+1+2*F3 

5970  LET  0[J,I1]=EO/E[L2,I1] 

6030  LET  E1=G[P3,I1] 

6040  FOR  1=  0  TO  N-1 

6050  GOSUB  1700 

6060  LET  H[I+13,I1]=A1 

6070  NEXT  I 

6120  GOTO  6160 

6130  IF  P3=l  GOTO  6160 

6140  LET  P3=l 

6150  GOTO  5920 

6160  NEXT  II 

6170  FOR  1=  0  TO  N-1 

6180  IF  PIJ,I]=  0  GOTO  6381 

6190  LET  Y1=A[Z[J] ]/A[Z [I] ] *H [ J+1 3 , I ] /2 * ( (0 [ J , I ] -1 ) / (U [ J ] -1 ) ) " 1 . 6 

6200  LET  Tl=  EXP   (2.373*  LOG   ( Z  [  I ] ) -8  . 902 ) 

6210  LET  T2=  EXP   (2.946*  LOG   ( Z  [  I ] ) -1 3  . 94 ) 

6220  IF  P[J,I]>1  GOTO  6250 
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6230  LET  D1=.88*T1 

6240  GOTO  6380 

6250  IF  P[J,I1>2  GOTO  6280 

6260  LET  D1=3.696*T2 

6270  GOTO  6380 

6280  IF  P[J,I]>3  GOTO  6310 

6290  LET  D1=.18*T1 

6300  GOTO  6380 

6310  IF  P[J,I]>4  GOTO  6340 

6320  LET  D1=.75*T2 

6330  GOTO  6380 

6340  IF  P[J,I]>5  GOTO  6370 

6350  LET  D1=.01*T1 

6360  GOTO  6380 

6370  LET  D1=.01*T2 

6380  LET  0[J,I]=D1*Y1 

6381  NEXT  I 

6382  LET  Ul=U[J] 

6383  IF  Ul<=10  GOTO  6385 

6384  LET  Ul=10 

6385  LET  Gl= .  00873  *Ul '^3- .  1669 *Ul  *U1+ .  9662*U1+ .  4523 

6386  LET  G2= . 00270 3*U1 *3- . 05182 *U1 *U1+ . 302*U1- . 1836 

6387  LET  P2= .  887-3  . 44/U1+9  .  33/Ul  ^2-6  .  43/Ul '^3 
6392  FOR  1=  0  TO  N-1 

6394  LET  V [I , J] =G1-G2*  LOG  (P2*Z[I]+25) 

6395  LET  S [ I , J] =2 *Z [I ] / ( A [ Z [ I ] ] * (EO+E [Bl , J] ) ) 

6396  LET  S [I , J] =S  [I  ,  J] *  LOG  (583* (EO+E [Bl , J] ) /  FNJ(Z[I])) 
6398  NEXT  I 


6400  NEXT  J 

6405  LET  G4=  0 

6410  IF  N3=  0  GOTO  6550 

6417  PRINT  "NO  PLOT  ENTER  0" 

6418  INPUT  G4 
6420  LET  Sl=  0 
6425  PRINT 

6430  FOR  1=  0  TO  N-1 

6440         IF  L[I]=  0  GOTO  6480 

6450         LET  M[I]=  ROI  (1+2) 

6460         LET  M[I]=M[I] /Q [I] 

6470         LET  S1=S1+M[I] 

6480  NEXT  I 

6490  IF  L[N-1]>  0  GOTO  6520 

6500  LET  C[N-1]=1-S1 

6510  LET  Sl=l 

6520  FOR  1=  0  TO  N-1 

6530         LET  C[I]=M[I]/S1 

6540  NEXT  I 

6550  FOR  Nl=  0  TO  N3 

6560         FOR  11=  0  TO  N-1 

6570  IF  L[I1]=  0  GOTO  6880 
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6580  LET  S2=  0 

6590  LET  X2=  0 

6600  LET  A2=  0 

6610  FOR  J=  0  TO  N-1 

6620  LET  S2=S2+C [J] *S  [J,I1] 

6630  LET  X2=X2+C[J]*V[J,I1] 

6640  LET  A2=A2+C [J] *H  [J  ,11] 

6650  NEXT  J 

6660  LET  El=  FNG(Il) 

6670  GOSUB  2100 

6680  LET  W1=(V[I1,I1]*S2)/(S[I1,I11*X2) 

6690  LET  F[1,I1]=F1 

6700  LET  F2=  0 

6710  FOR  J=  0  TO  N-1 

6720  IF  P[I1,J]=  0  GOTO  6810 

6730  LET  A3=  0 

6740  FOR  1=  0  TO  N-1 

6750  LET  A3=A3+C [I] *H [1+13 , J] 

6760  NEXT  I 

6770  LET  X1=Q1*A2/A3 

6780  LET  B1=(333000/(E0"1.65-E1'1.65))/A3*Q2 

6790  LET  F4=  LOG    (1+X1)/X1+  LOG  (1+Bl)/Bl 

6800  LET  F2=F2+C[J]*0[I1,J]/A3*F4 

6810  NEXT  J 

6815  IF  C[I1]=  0  GOTO  6880 

6820  LET  G3=C[I1]/W1*(1+F2)*F[1,I1]/F[  0,11] 

6830  IP  N3>  0  GOTO  6870 

6835  IF  L[I1]=  0  GOTO  6880 

6840  LET  M[I1]=M[I1]/G3 

6850  PRINT  "MELS  =";G3 

6860  GOTO  6880 

6870  LET  G2=M[I1] *C(I1] 

6872  LET  C  [ 1 1 ] =G2* { 1-G3 ) / (G2+G3* ( 1-M [ 1 1 ] -C [II ] ) ) 

6874  IF  NKN3  GOTO  6880 

6875  IF  G4=  0  GOTO  6880 

6876  GOSUB  8200 
6880  NEXT  II 

6890  IF  N3=  0  GOTO  7110 

6900  LET  Sl=  0 

6910  FOR  1=  0  TO  N-1 

6915  IF  L[I]=  0  GOTO  6930 

6916  IF  C[I]>  0  GOTO  6920 

6917  LET  C[I]=  0 
6920  LET  S1=S1+C [I] 
6930  NEXT  I 

6940  IF  L[N-1]>  0  GOTO  6970 

6950  GOSUB  8600 

6970  IF  N1=N3  GOTO  7050 

6980  GOSUB  2200 

6982  CALL  4, (  0) 
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6986  CALL  4, (3) 

6990  GOSUB  5100 

6992  CALL  A, (3) 

6996  CALL  4,(0) 

7000  FOR  1=  0  TO  N-1 

7010  IF  L[I]=  0  GOTO  7040 

7020  LET  M[I]=W[I]/Q[I] 

7030  LET  C[I]=C[I]/S1 

7040  NEXT  I 

7050  NEXT  Nl 

7060  PRINT  "Z" /'C" ,"F(X) "  ,"K" 

7070  FOR  1=  0  TO  N-1 

7075  IF  L[I]=  0  GOTO  7085 

7030  PRINT  Z [I]  ,C[I]  ,F[1,I]  ,M[I] 

7082  GOTO  7090 

7085  PRINT  Z [I] ,C [I] 

7090  NEXT  I 

7100  PRINT  "TOTAL  =";S1 

7105  CALL  4, (2) 

7110  FOR  1=  0  TO  1 

7120  LET  T5=  ROI  (I) 

7130  PRINT  "ROI";I,   FNE (  LCN    (157));   FNE (  LCN  (158)) 

7140  NEXT  I 

7150  RETURN 

8000  REM         SUBROUTINE  TO  CREATE  A  ROI  FOR  EACH  MEASURED  LINE 

8010  LET  Ll=644 

8015  LET  K2=l 

8020  LET  Kl=1.1775 

8030  FOR  1=  0  TO  N-1 

8040  IF  L[I]=  0  GOTO  8130 

8045  LET  K2=K2+1 

8046  LET  Il=L[Il-l 

8050  LET  Sl=  FNS(G[I1,I]) 

8060  LET  El=  FNN (G [I 1 , I ] -Kl *S1 ) 

8070  LET  E2=  FNN (G [II , I] +K1*S1) 

8075  CALL  1,101,K2 

8030  CALL  1,L1,E1 

8090  LET  Ll=Ll+l 

8100  CALL  1,L1,E2 

8110  LET  L1=L1+1 

8120  CALL  5 

8130  NEXT  I 

8140  RETURN 

8200  REM                 THIS  ROUTINE  RECONSTRUCTS  PEAKS  IN  QUADRANT  3 

8210  LET  T5=G3*Q[I1]/F[3,I1] 

8230  CALL  4, (3) 

8240  LET  K2=  FNA(5)/10000 

8250  LET  El=  FNG(Il) 

8260  LET  Sl=  FNS(El) 

8270  LET  E3=  FNN  (El-K2*Sl) 
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8280  LET  E4=  FNN (El+K2*Sl) 

8290  LET  Gl=  0 

8300  LET  E2=l 

8305  LET  S2=S1 

8310  G0SU3  8500 

8315  LET  T5=T5/G1*S1 

8320  FOR  Kl=  0  TO  16 

8330  LET  E1=G[K1,I1] 

8340  IF  EK.7  GOTO  8450 

8345  IF  El>10  GOTO  8450 

8350  LET  S2=  FNS(El) 

8355  LET  E3=  FNN(E1-4*S2) 

8360  LET  E4=  FNN(E1+4*S2) 

8365  LET  S6=  FNA ( 700+20 *I 1+Kl ) /lOOO 00 

8370  IF  S6=  0  GOTO  8450 

8375  LET  E2=T5/S2*S6 

8380  LET  A2=  0 

8385  FOR  1=  0  TO  N-1 

8390  GOSUB  1700 

8395  LET  A2=A2+C [ I 1 *Al 

8400  NEXT  I 

8405  GOSUB  2000 

8410  GOSUB  2100 

8415  LET  E2=E2*D2*F1 

8425  CALL  4,(2) 

8430  GOSUB  8500 

8435  CALL  5 

8440  CALL  4, (2) 

8445  CALL  4, (3) 

8450  NEXT  Kl 

8460  CALL  4, (  0) 

8470  RETURN 

8500  FOR  J=E3  TO  E4 

8505  IF  J>1023  GOTO  8590 

8510  LET  Jl=  FNE(J) 

8520  LET  T1=E2*  EXP    (-.5*  ABS    ( (Jl-El)/S2) "2) 

8530  IF  E2>1  GOTO  8560 

8540  LET  G1=G1+T1 

8550  GOTO  8590 

8560  LET  Ll=  FNC(J) 

8570  LET  T1=T1+  FNA(J) 

8580  CALL  3,Ll,Tl 

8590  NEXT  J 

859  5  RETURN 

8600  REM             STOICHIOMETRY  CALC 

8605  LET  C[N-1]=  0 

8610  CALL  4, (  0) 

8620  CALL  4, (3) 

8630  FOR  1=  0  TO  N-2 

8640  FOR  J=10  TO  N9  STEP  10 
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8650  IF     FNA(J)=Z[I]   GOTO  8670 

8660         NEXT  J 

8665         PRINT  "ELEMENT  ";Z[I]?"  NOT  FOUND" 

8667  STOP 

8670         LET  G3=  FNA(J+3) 

8675        IF  G3=  0  GOTO  8720 

8680         LET  F3=.5*C[I]*G3*A[Z(N-1]]/A[Z[I]] 

8690         LET  C[N-1]=C [N-11+F3 

8700  NEXT  I 

8702  LET  S1=S1+C[N-1] 

8704  CALL  4,(3) 

8705  CALL  4,(0) 
8710  RETURN 

8720  LET  C[N-1]=1-S1 

8730  LET  Sl=l 

8740  RETURN 
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100  RUM           THIS  ROUTIiME  COMPUTES  THE  THICKlnIESS  OF  THE  BE  WINDOW 

102  REM     AND  THE  THICKNESS  OF  THE  SI   DEAD  LAYER 

130  GOSUB  1000 

135  PRINT   "ENTER  AT.    NO.    AND  EO" 

140  INPUT  Z [   0] , EO 

141  PRINT 

142  LET  L [  OJ  =10 

143  LET  Ny=l 

144  LET  N=l 

145  LET  Z[N]=4 

146  LET  Z  [N  +  1]  =14 

147  LET  Z[N+2]=79 

148  FOR  1=  0  TO  N+2 

149  GOSUB  1500 

150  NEXT  I 

151  LET  C[   0] =1 

152  FOR  P2=  0  TO  14 

154  GOSUB  2200 

155  FOR  1=2  TO  3 

160  LET  M[I]=  ROI    (!)/(   LCN    (158)-  LCN  (157)) 

170  LET  W[I]=  FNE((   LCN   (157)+   LCN   (158) )/2) 

180  NEXT  I 

181  FOR  J=2  TO  3 
185  LET   1=  0 
190  LET  E1=W[J] 
200  GOSUB  1700 
210  LET  A2=A1 
220  GOSUB  2100 

230  LET  Tl=  LOG  (Fl/El) 

240  LET  Gl=  LOG    (M [ J] ) 

250  LET  X1=E0-E1 

260  LET  I=N 

270  GOSUB  1700 

274  LET  X[J-2] =A1*1.82 

275  LET  I=N+1 

276  GOSUB  1700 

280  LET  Y[J-2]=A1*2.33 

285  LET  I=N+2 

29U  GOSUB  1700 

291  LET  A3=Al*19.3*8E-7 

292  LET  U  [J-2] =  LOG    (Kl*Xl*Xl+K2*Xl) -G1+T1-A3 

2  93  NEXT  J 

294  LET  Dl=X[    0]*Y[1]-Y[  0]*X[1] 

295  LET  P6=(U[   0 ] *Y [ 1] -U [ 1 ] * Y [   0 ] ) /Dl 

296  LET  P7=(X[   0] *U [ 1] -X [ 1 ] * U [   0 ] ) /Dl 
300  PRINT   "T  BE=";P6;"T  SI=";P7 

310  NEXT  P2 

312  PRINT   "INSERT  THESE   VALUES  INTO  LINES   1454  AND  1455" 

320  STOP 

3  90  END 
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